package AddonHG;

use strict;
use warnings;

use URI;
use File::Spec;
use File::Spec::Unix;
use IO::Pipe;
use Date::Parse;
use Cwd qw(realpath);

BEGIN {
    eval { require Data::Dumper; } and eval { import Data::Dumper; $Data::Dumper::Sortkeys = 1; $Data::Dumper::Indent = 1; };
}
our $has_dumper = ( defined &Data::Dumper::new );

use Constants qw( :dir :file :vinfo :svn :source );
use Options;
use Database;
use AddonKey;
use AddonDiff;
use FormatString;
use TOCInfo;

BEGIN {
    use Exporter ();
    our ( $VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS );

    $VERSION = sprintf( "%d", q$Revision$ =~ m{\d+} );
    @ISA     = qw(Exporter);
    @EXPORT  = qw(&get_hg_info
        &get_hg_status
        &get_hg_log
        &fetch_hg_to_path);
    %EXPORT_TAGS = ();
    @EXPORT_OK   = qw();
} ## end BEGIN

our %hg_cache       = ();
our %hg_info_cache  = ();
our %hg_fetch_cache = ();

sub p_get_hg_root_path($ );
sub p_get_cache($;$ );
sub p_get_cmd($;@ );
sub p_get_branch($ );
sub p_get_revision_author_date_hash($ );

sub get_hg_info($ );
sub get_hg_status($ );
sub p_dump_rec_lines($$\%@ );
sub get_hg_log($$$ );
sub fetch_hg_to_path($$$$$ );

# Consider using: hg root -cwd $path
sub p_get_hg_root_path($ ) {
    my $path = shift;

    return $path unless ( -e $path );

    my $hg_entries = File::Spec->catdir( $path, &DIR_HG, &FILE_DIRSTATE );

    return $path, $hg_entries if -e $hg_entries;

    my $real_path = realpath( File::Spec->canonpath( $path ) );
    my ( $vol, $dir, $file ) = File::Spec->splitpath( $real_path, 1 );
    my @path_dirs = File::Spec->splitdir( $dir );
    my @suffix;
    unshift @suffix, $file if $file ne "";

    while ( @path_dirs ) {
        my $try_path = File::Spec->catpath( $vol, File::Spec->catdir( @path_dirs ), "" );
        my $try_hg_entries = File::Spec->catdir( $try_path, &DIR_HG, &FILE_DIRSTATE );
        return $try_path, $try_hg_entries, File::Spec->catfile( @suffix )
            if ( -e $try_hg_entries );
        unshift @suffix, ( pop @path_dirs );
    } ## end while ( @path_dirs )
    return $path, $hg_entries;
} ## end sub p_get_hg_root_path($ )

sub p_get_cache($;$ ) {
    my ( $path, $root_cache ) = @_;
    if ( ref $path ) {
        return $path->{ root_cache } if ( $root_cache );
        return $path;
    }
    return undef unless defined $path;
    my ( $rpath, $hg_entries, $suffix ) = p_get_hg_root_path( $path );
    return undef unless defined $hg_entries;
    return undef unless -e $hg_entries;
    if ( $root_cache ) {
        $path = $rpath;
        undef $suffix;
    }
    my $key = get_file_key( $hg_entries );
    return undef unless defined $key;
    $key .= "/" . $suffix if defined $suffix;
    my $res = $hg_cache{ $key };
    unless ( $res ) {
        my $hg_cmd = find_command( "hg" );
        return $res unless defined $hg_cmd;
        $res = {
            key    => $key,
            path   => $path,
            rpath  => $rpath,
            suffix => $suffix,
            cmd    => [ $hg_cmd, "-R", $rpath ]
        };
        if ( defined $suffix ) {
            $res->{ root_cache } = p_get_cache( $rpath );
        }
        else {
            $res->{ root_cache } = $res;
        }
        $hg_cache{ $key } = $res;
    } ## end unless ( $res )
    return $res;
} ## end sub p_get_cache($;$ )

sub p_get_cmd($;@ ) {
    my $cache = p_get_cache( shift );
    return () unless $cache;
    return @{ $cache->{ cmd } }, @_;
}

sub p_get_branch($ ) {
    my $cache = p_get_cache( shift, 1 );
    return undef unless $cache;
    unless ( exists $cache->{ branch } ) {
        my $res;
        my @cmd = p_get_cmd( $cache, "branch" );
        my $hg_in = new IO::Pipe;
        $hg_in->reader( @cmd );
        while ( <$hg_in> ) {
            chomp;
            $res = $_;
        }
        undef $res unless ( $hg_in->close && ( $? == 0 ) );
        undef $res unless ( defined $res && $res ne "" );
        $cache->{ branch } = $res;
    } ## end unless ( exists $cache->{ ...})
    return $cache->{ branch };
} ## end sub p_get_branch($ )

sub p_get_revision_author_date_hash($ ) {
    my $cache = p_get_cache( shift );
    return undef unless $cache;
    unless ( exists $cache->{ revision_author_date_hash } ) {
        my @cmd = p_get_cmd( $cache, "log", "-l", "1", $cache->{ path } );
        my $hg_in = new IO::Pipe;
        $hg_in->reader( @cmd );
        while ( <$hg_in> ) {
            chomp;
            my ( $field, $value ) = split( m{:\s*}, $_, 2 );
            if ( defined $value ) {
                if ( $field eq "changeset" ) {
                    if ( $value =~ s{:(.*)}{} ) {
                        $cache->{ hash } = $1;
                    }
                    $cache->{ revision } = $value;
                } ## end if ( $field eq "changeset")
                elsif ( $field eq "user" ) {
                    $cache->{ author } = ( split( m{@}, $value, 2 ) )[ 0 ];
                }
                elsif ( $field eq "date" ) {
                    $cache->{ date } = str2time( $value );
                }
            } ## end if ( defined $value )
        } ## end while ( <$hg_in> )
        $cache->{ revision_author_date_hash } = 1;
    } ## end unless ( exists $cache->{ ...})
} ## end sub p_get_revision_author_date_hash($ )

sub p_get_revision($ ) {
    my $cache = p_get_cache( shift );
    p_get_revision_author_date_hash( $cache );
    return $cache->{ revision };
}

sub p_get_hash($ ) {
    my $cache = p_get_cache( shift );
    p_get_revision_author_date_hash( $cache );
    return $cache->{ hash };
}

sub p_get_author($ ) {
    my $cache = p_get_cache( shift );
    p_get_revision_author_date_hash( $cache );
    return $cache->{ author };
}

sub p_get_date($ ) {
    my $cache = p_get_cache( shift );
    p_get_revision_author_date_hash( $cache );
    return $cache->{ date };
}

sub p_get_url($ ) {
    my $cache = p_get_cache( shift );
    return undef unless $cache;
    unless ( exists $cache->{ url } ) {
        my $res;
        my $branch = p_get_branch( $cache );
        if ( $branch ) {
            my @cmd = p_get_cmd( $cache, "paths", $branch );
            my $hg_in = new IO::Pipe;
            $hg_in->reader( @cmd );
            $res = <$hg_in>;
            chomp $res;
            undef $res unless ( $hg_in->close && ( $? == 0 ) );
            undef $res unless ( defined $res && $res ne "" );
            if ( defined $res && $cache->{ suffix } ) {
                $res = $res . "/" . $cache->{ suffix };
            }
        } ## end if ( $branch )
        $cache->{ url } = $res;
    } ## end unless ( exists $cache->{ ...})
    return $cache->{ url };
} ## end sub p_get_url($ )

sub get_hg_info($ ) {
    my $path = shift;
    return $path if ref $path;
    my $res;
    my $cache = p_get_cache( $path );
    if ( defined $cache ) {
        $res = $cache->{ info };
        unless ( defined $res ) {
            my $hg_branch = p_get_branch( $cache );
            my $hg_id     = $hg_branch && p_get_revision( $cache );
            my $hg_url    = $hg_id && p_get_url( $cache );
            my $hg_hash   = $hg_url && p_get_hash( $cache );
            my $hg_author = $hg_hash && p_get_author( $cache );
            my $hg_date   = $hg_author && p_get_date( $cache );
            if ( defined $hg_date ) {
                my $root_info;
                my $root_path;
                my $root_id;
                my $root_hash;
                my $root_author;
                my $root_date;
                if ( $cache->{ suffix } ) {
                    $root_info   = get_hg_info( $cache->{ rpath } );
                    $root_path   = $root_info && $root_info->{ &VINFO_REPO_PATH };
                    $root_id     = $root_info && $root_info->{ &VINFO_PROJECT_REVISION };
                    $root_hash   = $root_info && $root_info->{ &VINFO_PROJECT_HASH };
                    $root_author = $root_info && $root_info->{ &VINFO_PROJECT_AUTHOR };
                    $root_date   = $root_info && $root_info->{ &VINFO_PROJECT_TIMESTAMP };
                } ## end if ( $cache->{ suffix ...})
                $res = {
                    _KEY_            => $cache->{ key },
                    &VINFO_REPO_TYPE => &SOURCE_HG,
                    &VINFO_REPO_NAME => path_to_node( $path ),
                    &VINFO_REPO_PATH => $path,
                    &VINFO_REPO_ROOT => $root_path || $path,
                    &VINFO_FILE_REVISION     => $hg_id,
                    &VINFO_DIR_REVISION      => $hg_id,
                    &VINFO_PROJECT_REVISION  => $root_id || $hg_id,
                    &VINFO_FILE_HASH         => $hg_hash,
                    &VINFO_PROJECT_HASH      => $root_hash || $hg_hash,
                    &VINFO_FILE_AUTHOR       => $hg_author,
                    &VINFO_PROJECT_AUTHOR    => $root_author || $hg_author,
                    &VINFO_FILE_TIMESTAMP    => $hg_date,
                    &VINFO_PROJECT_TIMESTAMP => $root_date || $hg_date,
                    &VINFO_URL               => $hg_url,

                    &SVN_REPOSITORY_ROOT => $hg_url,
                };
            } ## end if ( defined $hg_date )
            else {
                $res = "broken";
            }
            $cache->{ info } = $res;
        } ## end unless ( defined $res )
        return $res if ref $res;
        undef $res;
    } ## end if ( defined $cache )
    return generic_get_info( $path );
} ## end sub get_hg_info($ )

sub get_hg_status($ ) {
    my $path = shift;
    $path = File::Spec->canonpath( $path );
    my ( $has_custom, $has_external );
    return ( $has_custom, $has_external ) unless defined $path;
    my $hg_dir = File::Spec->catfile( $path, &DIR_HG );
    my $hg_cmd = find_command( "hg" );
    if ( $hg_cmd && -d $hg_dir ) {
        $has_custom = 0;
        my @cmd = ( $hg_cmd, "status", "-R", $path );
        my $hg_in = new IO::Pipe;
        $hg_in->reader( @cmd );
        while ( <$hg_in> ) {
            chomp;
            next unless ( m{(.)\s(.*)} );
            $has_custom = 1;
        }
        return ( undef, undef ) unless ( $hg_in->close && ( $? == 0 ) );
    } ## end if ( $hg_cmd && -d $hg_dir)
    return ( $has_custom, $has_external );
} ## end sub get_hg_status($ )

sub p_dump_rec_lines($$\%@ ) {
    my ( $src_rev, $dest_rev, $rec, @comments ) = @_;

    my @res = ();

    my ( $rev, $gid ) = split( ':', $rec->{ "changeset" }, 2 );
    $rev ||= 0;
    $gid ||= "????????????";
    my $author = $rec->{ "user" } || "????";
    my $date   = $rec->{ "date" } || "Mist of time";

    my $color  = "";
    my $creset = "";
    my $body   = "";
    my $breset = "";
    if ( $rev == $dest_rev ) {
        $color  = AddonDiff::ColorSubtract;
        $creset = AddonDiff::ColorReset;
        $body   = AddonDiff::ColorPlain;
        $breset = AddonDiff::ColorReset;
    } ## end if ( $rev == $dest_rev)
    elsif ( $rev == $src_rev ) {
        $color  = AddonDiff::ColorAdd;
        $creset = AddonDiff::ColorReset;
    }

    push @res, AddonDiff::ColorPlain . ( "-" x 72 ) . AddonDiff::ColorReset . "\n";
    push @res, $color . "r" . $rev . $creset . AddonDiff::ColorMeta . " | " . $author . " | " . $date . " | " . ( scalar @comments ) . " line" . ( @comments != 1 ? "s" : "" ) . AddonDiff::ColorReset . "\n", "\n";
    push @res, map { $body . $_ . $breset . "\n" } @comments;
    return @res;
} ## end sub p_dump_rec_lines($$\%@ )

sub get_hg_log($$$ ) {
    my ( $src_path, $src_rev, $dest_rev ) = @_;

    my @res = ();
    return @res unless -d File::Spec->catfile( $src_path, &DIR_HG );

    my $hg_cmd = find_command( "hg" );
    return @res unless defined $hg_cmd;

    my @cmd = ( $hg_cmd, "log", "-v", "-r", $src_rev . ":" . $dest_rev, "-R", $src_path );
    my $hg_in = new IO::Pipe;
    $hg_in->reader( @cmd );
    my $in_record   = 1;
    my $space_count = 0;
    my %rec         = ();
    my @lines       = ();
    while ( <$hg_in> ) {
        my $line = chomp;
        if ( !$in_record && $space_count >= 2 && m{^changeset:} ) {
            push @res, p_dump_rec_lines( $src_rev, $dest_rev, %rec, @lines );
            $space_count = 0;
            $in_record   = 1;
            @lines       = ();
            %rec         = ();
        } ## end if ( !$in_record && $space_count...)
        if ( $in_record ) {
            my ( $field, $value ) = split( m{:\s*}, $_, 2 );
            if ( defined $field && $field eq "description" ) {
                undef $in_record;
            }
            elsif ( defined $value ) {
                $rec{ $field } = $value;
            }
        } ## end if ( $in_record )
        elsif ( $_ eq "" ) {
            ++$space_count;
        }
        else {
            push @lines, ( ( "" ) x $space_count ), $_;
        }
    } ## end while ( <$hg_in> )
    $hg_in->close;
    push @res, p_dump_rec_lines( $src_rev, $dest_rev, %rec, @lines );

    return @res;
} ## end sub get_hg_log($$$ )

sub fetch_hg_to_path($$$$$ ) {
    my ( $name, $path, $url, $ignore_mismatch, $auto_force ) = @_;

    $url =~ s{/*$}{};
    my $uri = URI->new( $url )->canonical;
    $url = $uri->as_string;

    my $uri_cache = $hg_fetch_cache{ $url } ||= {};
    unless ( exists $uri_cache->{ $path } ) {
        $uri_cache->{ $path } = [ 0, undef ];    # Allow early return to be treated as failure
        my $res         = $uri_cache->{ $path };
        my $did_fetch   = 0;
        my $can_comment = 1;

        my $hg_cmd = find_command( "hg" );
        unless ( defined $hg_cmd ) {
            warn "Unable to locate hg command. make sure you have mercurial installed and in your path\n";
            exit 10;
        }

        my @args = ();
        push @args, "-q" unless $opt_output{ "verbose" };
        my @cmd         = ( $hg_cmd );
        my @cd_cmd      = ();
        my $just_update = undef;
        my $fetch_path  = $path;

        if ( $opt_flags{ "force" } ) {
            $fetch_path = $path . ".force";
        }
        elsif ( -e $path ) {
            my $hg_path = File::Spec->catdir( $path, &DIR_HG );
            if ( -d $hg_path ) {
                $just_update = 1;
            }
            elsif ( $auto_force ) {
                $fetch_path = $path . ".force";
            }
            else {
                warn "Missing .hg directory for addon: " . $name . ", use -force if you wish to fetch and replace\n";
                return @$res;
            }
        } ## end elsif ( -e $path )

        if ( $just_update ) {
            push @cmd, ( @args, "update", "-R", $path );
            $fetch_path = $path;
        }
        else {
            push @cmd, ( @args, "clone", $url, $fetch_path );
        }
        print_command( @cmd ) if ( $opt_output{ "verbose" } );
        unless ( $opt_flags{ "dryrun" } ) {
            my $svn_in = new IO::Pipe;
            $svn_in->reader( @cmd );
            my $need_print;
            my @res = ();
            while ( <$svn_in> ) {
                push @res, $_;
                next if ( m{^\s*$} );
                next if ( m{^0 files updated, 0 files merged, 0 files removed, 0 files unresolved$} );
                $need_print = 1;
                undef $can_comment;
            } ## end while ( <$svn_in> )
            print_command( @cmd ) if $need_print && !$opt_output{ "verbose" };
            print @res if $need_print || $opt_output{ "verbose" };
            my $any_errors = 0;
            unless ( $svn_in->close && ( $? == 0 ) ) {
                warn "Unable to get: " . $name . "\n";
                $::exit_res = 1;
                $any_errors = 1;
            }
            if ( $any_errors ) {
                undef $can_comment;
            }
            else {
                if ( ( $fetch_path ne $path ) && ( -d $fetch_path ) && !$any_errors ) {
                    my $bak_path = $path . ".bak";
                    if ( -e $path ) {
                        rmtree( $bak_path, $opt_output{ "verbose" } ) if -e $bak_path;
                        print_command( "mv", $path, $bak_path ) if ( $opt_output{ "verbose" } );
                        rename( $path, $bak_path );
                    }
                    print_command( "mv", $fetch_path, $path ) if ( $opt_output{ "verbose" } );
                    rename( $fetch_path, $path );
                } ## end if ( ( $fetch_path ne ...))
                if ( -d $path ) {
                    $did_fetch = 1;
                }
                else {
                    undef $can_comment;
                }
            } ## end else [ if ( $any_errors ) ]
        } ## end unless ( $opt_flags{ "dryrun"...})
        $uri_cache->{ $path } = [ $did_fetch, $can_comment ];
    } ## end unless ( exists $uri_cache...)
    return @{ $uri_cache->{ $path } };
} ## end sub fetch_hg_to_path($$$$$ )

1;
